unit wgetbmp;

{****************************************************************************}

interface

uses Wincrt,Windos,
      CartoCmds,        (* Contient les def. globales *)
      tit_win,get_win,gmuf_win,aux_win,coul_win;


(*************************** gethff - 3 Nov 90 *****************************)

function get_bmp(nomsc:st64;var nlig_capt, ncol_capt, bit_count:integer;
                  var data_offset, palette_offset, max_offset:longint;
                  var table_bmp:Pctable): integer;

{****************************************************************************}

implementation

(*************************** getbmp - 5 Juin 91 *****************************)

function get_bmp(nomsc:st64;var nlig_capt, ncol_capt, bit_count :integer;
                  var data_offset, palette_offset, max_offset:longint;
                  var table_bmp:Pctable): integer;

const

(* FORMAT D'IMAGE IMAGEPRO bmp *)

     card_capt = 8;

var   ier,i,l,k,n:integer;

      bmp:file;
      buf_bmp:byte;
      buf_word:array[1..2] of byte;
      bufint_long:array[1..2] of integer;

      val_id:array[1..2] of char;
      val_filesize:longint;
      val_headersize:longint;
      val_infoSize:longint;
      val_width:longint;
      val_depth:longint;
      val_biPlanes:integer;
      val_bits:integer;
      val_biCompression:longint;
      val_biSizeImage:longint;
      val_biXp,val_biYp:longint;
      val_ClrUsed:longint;
      val_ClrImportant:longint;

      palette_read : boolean;

      nbs_samples:word;

label 999;

begin

  get_bmp := 1;

  ncol_capt := 0;
  nlig_capt := 0;
  nbs_samples := 0;
  data_offset := 0;
  palette_offset := 0;
  max_offset := 0;

  {$I-}

  assign(bmp,nomsc);
  reset(bmp,1);
  if ioresult <> 0 then begin get_bmp := -1; goto 999; end;

(* Type BMP *)
  for i := 1 to 2 do blockread(bmp,buf_word[i],1);
  for i := 1 to 2 do val_id[i] := char(buf_word[i]);
(*  writeln('BMP_ID : '+val_id[1]+val_id[2]);  *)

(* FileSize *)
  blockread(bmp,val_FileSize,4);
(*  writeln('FILESIZE : ',val_FileSize); *)
  max_offset := val_FileSize;

  for i := 1 to 2 do blockread(bmp,bufint_long[i],2);

(* HeaderSize *)
  blockread(bmp,val_HeaderSize,4);
  data_offset := val_headerSize;
(*  writeln('HEADERSIZE : ',val_HeaderSize); *)

(* InfoSize *)
  blockread(bmp,val_InfoSize,4);
(*  writeln('INFOSIZE : ',val_InfoSize);  *)
{
  palette_read := FALSE;
  if val_HeaderSize > 1024 + val_InfoSize then palette_read := TRUE;
}
(* Image Param. *)
  blockread(bmp,val_width,4);
  ncol_capt := val_width;
(*  writeln('WIDTH : ',val_width); *)
  blockread(bmp,val_depth,4);
  nlig_capt := val_depth;
(*  writeln('DEPTH : ',val_depth); *)

(* Bits Info *)
  blockread(bmp,val_biPlanes,2);
(*  writeln('BIPLANES : ',val_biPlanes);  *)
  blockread(bmp,val_bits,2);
(*  writeln('BITS : ',val_bits); *)
  bit_count := val_bits;

  blockread(bmp,val_biCompression,4);
(*  writeln('BICOMPRESSION : ',val_biCompression); *)
  blockread(bmp,val_biSizeImage,4);
(*  writeln('BISIZEIMAGE : ',val_biSizeImage);  *)

  blockread(bmp,val_biXp,4);
(*  writeln('BIXPIX_METER : ',val_biXp); *)
  blockread(bmp,val_biYp,4);
(*  writeln('BIYPIX_METER : ',val_biYp);  *)

  blockread(bmp,val_ClrUsed,4);
(*  writeln('NbColours_Used : ',val_ClrUsed);  *)
  { Corrections en fonctions SDK manual Vol2 p7-12
    Valable uniquement pour 8bits}
  if (val_ClrUsed = 0) then val_ClrUsed := 256;
  if val_ClrUsed > 256 then begin
    get_bmp := -2;
    close(bmp);
    goto 999;
  end;

  blockread(bmp,val_ClrImportant,4);
(*  writeln('NbColours_Important : ',val_ClrImportant); *)

    for l := 1 to 256 do
      begin
       table_bmp^[3,l-1] := 0;
       table_bmp^[2,l-1] := 0;
       table_bmp^[1,l-1] := 0;
      end;

  if val_bits < 8 then begin
     palette_offset := -1;
     close(bmp);
     get_bmp := 0;
     goto 999;
  end;

  if val_bits = 24 then begin
     palette_offset := -1;
     close(bmp);
     get_bmp := 0;
     goto 999;
  end;

  if val_bits = 8 then begin
(*
    if not(palette_read) then begin  close(bmp); get_bmp := -3; goto 999; end;
*)
    for l := 1 to val_ClrUsed do
      begin
       blockread(bmp,table_bmp^[3,l-1],1);
       blockread(bmp,table_bmp^[2,l-1],1);
       blockread(bmp,table_bmp^[1,l-1],1);
       blockread(bmp,buf_bmp,1);
      end;
    palette_offset := 1;
  end else begin close(bmp); palette_offset := -1; get_bmp := -2; goto 999; end;
(*
  table_bmp^[1,255] := 255;
  table_bmp^[2,255] := 255;
  table_bmp^[3,255] := 255;
*)
  close(bmp);
  get_bmp := 0;

999:end;

end.

